home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / PCONFRE2.ARJ / ARCTEXT.LSP < prev    next >
Lisp/Scheme  |  1988-08-16  |  3KB  |  99 lines
  1. (defun C:ARCTEXT ()
  2. (if ho (progn
  3.     (setq h (getreal (strcat "Give Character Height <" (rtos ho) "> : ")))
  4.     (if (= h nil) (setq h ho)))
  5.     (setq h (getreal "Give Character Height: ")))
  6.   (setq ho h)
  7. (if p0o (progn
  8.     (setq p0 (getpoint (strcat "\nGive Arc/Circle Center Point: <"
  9.                    (rtos (car p0o) 2 2) "," (rtos (cadr p0o) 2 2) "> : ")))
  10.     (if (= p0 nil) (setq p0 p0o)))
  11.     (setq p0 (getpoint "\nGive Arc/Circle Center Point: ")))
  12.   (setq p0o p0)
  13. (if p1o (progn
  14.     (setq p1 (getpoint (strcat "\nGive Text Center Bottom Point: <"
  15.                    (rtos (car p1o) 2 2) "," (rtos (cadr p1o) 2 2) "> : ")))
  16.     (if (= p1 nil) (setq p1 p1o)))
  17.     (setq p1 (getpoint "\nGive Text Center Bottom Point: ")))
  18.   (setq p1o p1)
  19. (if dno (progn
  20.     (setq dn (getstring (strcat "\nClockwise or Anticlockwise <" dno "> : ")))
  21.     (if (= dn "" ) (setq dn dno)))
  22.   (setq dn (getstring "\nClockwise or Anticlockwise <C> : ")))
  23.   (if (= dn "" ) (setq dn "C"))
  24.   (setq dno dn)
  25. (if w1o (progn
  26.     (setq w1 (getreal (strcat "\nWidth Factor <" (rtos w1o 2 2) "> : ")))
  27.     (if (= w1 nil) (setq w1 w1o)))
  28.   (setq w1 (getreal "\nWidth Factor <1> : ")))
  29.   (if (= w1 nil) (setq w1 1.0))
  30.   (setq w1o w1)
  31. (if s1o (progn
  32.     (setq s1 (getreal (strcat "\nSpacing Adjustment <" (rtos s1o 2 2) "> : ")))
  33.     (if (= s1 nil) (setq s1 s1o)))
  34.   (setq s1 (getreal "\nSpacing Adjustment <0> : ")))
  35.   (if (= s1 nil) (setq s1 0))
  36.   (setq s1o s1)
  37. (setq tex "\nKey Text: ")
  38. (if texo (progn
  39.     (setq tex (strcat tex "<" texo "> : "))
  40.     (setq tex (getstring  tex "n\Key Tex : "))
  41.     (if (= tex "") (setq tex texo)))
  42.   (setq tex (getstring tex "Key Text: ")))
  43.   (setq texo tex)
  44. (setvar "cmdecho" 0)
  45. (setvar "highlight" 0)
  46. (setvar "blipmode" 0)
  47. (setq l (strlen tex))
  48. (setq n 1)
  49. (setq wfo 0)
  50. (setq ang (angle p0 p1))
  51. (setq r (distance p0 p1))
  52. (setq wid (list 0 100 40 80 86 108 115 98 40 60 60 83 83 40 83 40 83 102 65 92
  53. 96 96 98 98 86 95 98 40 40 60 83 60 89 140 118 105 113 110 96 96 115 104 40 90
  54. 110 94 126 110 120 98 120 99 108 98 108 118 156 120 110 98 60 80 60 77 121 40 85
  55.  92 89 92 92 57 92 87 34 45 87 34 133 87 92 92 92 51 81 57 87 89 128 95 90 77 ))
  56. (setq wt 0)
  57. (while (<= n l)
  58.     (setq tx (substr tex n 1))
  59.     (setq wf1 (/ (nth (- (ascii tx) 31) wid) 100.0))
  60.     (setq w (* (+ wf1 s1) w1 h))
  61.     (setq wt (+ wt w))
  62.     (setq n (1+ n))
  63. )
  64. (setq wt (- wt (* w1 h 0.2) s1))
  65. (setq n 1)
  66. (if (= (strcase dn) "A") (progn
  67.     (setq ang (- ang (/ (/ wt r) 2)))
  68.     (setq p1 (polar p0 ang r))
  69.    )
  70.        (progn
  71.     (setq ang (+ ang (/ (/ wt r) 2)))
  72.     (setq p1 (polar p0 ang r))
  73.   ))
  74. (while (<= n l)
  75.     (setq tx (substr tex n 1))
  76.     (setq wf1 (/ (nth (- (ascii tx) 31) wid) 100.0))
  77.     (setq w3 (* (/ (- wf1 0.2) 2.0) w1 h))
  78.     (setq wf (/ (+ wf1 wfo) 2.0))
  79.     (setq w (* (+ wf s1) w1 h))
  80. (if (= (strcase dn) "A") (progn
  81.        (if (= n 1) (setq ang1 (+ ang (/ w3 r))) (setq ang1 (+ ang (/ w r))))
  82.        (setq rot (+ (* ang1 (/ 180 pi)) 90))
  83.        (setq p2 (polar p0 (- ang1 (/ w3 r)) r)))
  84.        (progn
  85.        (if (= n 1) (setq ang1 (- ang (/ w3 r))) (setq ang1 (- ang (/ w r))))
  86.        (setq rot (- (* ang1 (/ 180 pi)) 90))
  87.        (setq p2 (polar p0 (+ ang1 (/ w3 r)) r)))
  88.   )
  89.     (command "text"  p2 h rot tx)
  90.     (setq n (1+ n))
  91.     (setq ang ang1)
  92.     (setq wfo wf1)
  93.     )
  94. (setvar "highlight" 1)
  95. (setvar "blipmode" 1)
  96. (setvar "cmdecho" 1)
  97. (princ)
  98. )
  99.